home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpcsrc.lha / fpc / compiler / ag68kmot.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  22KB  |  510 lines
  1. {
  2.     $Id: ag68kmot.pas,v 1.1.1.1.2.3 1998/09/14 18:56:26 carl Exp $
  3.     Copyright (c) 1998 by the FPC development team
  4.  
  5.     This unit implements an asmoutput class for MOTOROLA syntax with
  6.     Motorola 68000 (recognized by the Amiga Assembler and Charlie Gibbs's
  7.     A68k)
  8.  
  9.     This program is free software; you can redistribute it and/or modify
  10.     it under the terms of the GNU General Public License as published by
  11.     the Free Software Foundation; either version 2 of the License, or
  12.     (at your option) any later version.
  13.  
  14.     This program is distributed in the hope that it will be useful,
  15.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  16.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17.     GNU General Public License for more details.
  18.  
  19.     You should have received a copy of the GNU General Public License
  20.     along with this program; if not, write to the Free Software
  21.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  22.  
  23.  ****************************************************************************
  24. }
  25. unit ag68kmot;
  26.  
  27.     interface
  28.  
  29.     uses aasm,assemble;
  30.  
  31.     type
  32.       pm68kmotasmlist=^tm68kmotasmlist;
  33.       tm68kmotasmlist = object(tasmlist)
  34.         procedure WriteTree(p:paasmoutput);virtual;
  35.         procedure WriteAsmList;virtual;
  36.       end;
  37.  
  38.   implementation
  39.  
  40.     uses
  41.       dos,globals,systems,cobjects,m68k,
  42.       strings,files,verbose
  43. {$ifdef GDB}
  44.       ,gdb
  45. {$endif GDB}
  46.       ;
  47.  
  48.     const
  49.       line_length = 70;
  50.  
  51.     function getreferencestring(const ref : treference) : string;
  52.       var
  53.          s : string;
  54.       begin
  55.          s:='';
  56.          if ref.isintvalue then
  57.              s:='#'+tostr(ref.offset)
  58.          else
  59.            with ref do
  60.              begin
  61.                  if (index=R_NO) and (base=R_NO) and (direction=dir_none) then
  62.                    begin
  63.                      if assigned(symbol) then
  64.                        begin
  65.                          s:=s+symbol^;
  66.                          if offset<0 then
  67.                            s:=s+tostr(offset)
  68.                          else
  69.                          if (offset>0) then
  70.                            s:=s+'+'+tostr(offset);
  71.                        end
  72.                      else
  73.                        begin
  74.                        { direct memory addressing }
  75.                          s:=s+'('+tostr(offset)+').l';
  76.                        end;
  77.                    end
  78.                  else
  79.                    begin
  80.                      if assigned(symbol) then
  81.                        s:=s+symbol^;
  82.                      if offset<0 then
  83.                        s:=s+tostr(offset)
  84.                      else
  85.                      if (offset>0) then
  86.                        begin
  87.                          if (symbol=nil) then s:=tostr(offset)
  88.                          else s:=s+'+'+tostr(offset);
  89.                        end;
  90.                      if (index<>R_NO) and (base=R_NO) and (direction=dir_none) then
  91.                        begin
  92.                          if (scalefactor = 1) or (scalefactor = 0) then
  93.                            begin
  94.                              if offset = 0 then
  95.                                s:=s+'0(,'+mot_reg2str[index]+'.l)'
  96.                              else
  97.                                s:=s+'(,'+mot_reg2str[index]+'.l)';
  98.                            end
  99.                          else
  100.                            begin
  101.                              if offset = 0 then
  102.                                s:=s+'0(,'+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')'
  103.                              else
  104.                                s:=s+'(,'+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')';
  105.                            end
  106.                        end
  107.                      else
  108.                      if (index=R_NO) and (base<>R_NO) and (direction=dir_inc) then
  109.                        begin
  110.                          if (scalefactor = 1) or (scalefactor = 0) then
  111.                            s:=s+'('+mot_reg2str[base]+')+'
  112.                          else
  113.                            InternalError(10002);
  114.                        end
  115.                      else
  116.                      if (index=R_NO) and (base<>R_NO) and (direction=dir_dec) then
  117.                        begin
  118.                          if (scalefactor = 1) or (scalefactor = 0) then
  119.                            s:=s+'-('+mot_reg2str[base]+')'
  120.                          else
  121.                            InternalError(10003);
  122.                        end
  123.                      else
  124.                      if (index=R_NO) and (base<>R_NO) and (direction=dir_none) then
  125.                        begin
  126.                          s:=s+'('+mot_reg2str[base]+')';
  127.                        end
  128.                      else
  129.                      if (index<>R_NO) and (base<>R_NO) and (direction=dir_none) then
  130.                        begin
  131.                          if (scalefactor = 1) or (scalefactor = 0) then
  132.                            begin
  133.                              if offset = 0 then
  134.                                s:=s+'0('+mot_reg2str[base]+','+mot_reg2str[index]+'.l)'
  135.                              else
  136.                                s:=s+'('+mot_reg2str[base]+','+mot_reg2str[index]+'.l)';
  137.                            end
  138.                          else
  139.                           begin
  140.                             if offset = 0 then
  141.                               s:=s+'0('+mot_reg2str[base]+','+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')'
  142.                             else
  143.                               s:=s+'('+mot_reg2str[base]+','+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')';
  144.                           end
  145.                        end
  146.       { if this is not a symbol, and is not in the above, then there is an error }
  147.                      else
  148.                      if NOT assigned(symbol) then
  149.                        InternalError(10004);
  150.                    end; { endif }
  151.             end; { end with }
  152.          getreferencestring:=s;
  153.       end;
  154.  
  155.  
  156.     function getopstr(t : byte;o : pointer) : string;
  157.      var
  158.       hs : string;
  159.       i: tregister;
  160.     begin
  161.       case t of
  162.        top_reg : getopstr:=mot_reg2str[tregister(o)];
  163.          top_reglist: begin
  164.                       hs:='';
  165.                       for i:=R_NO to R_FPSR do
  166.                       begin
  167.                         if i in tregisterlist(o^) then
  168.                          hs:=hs+mot_reg2str[i]+'/';
  169.                       end;
  170.                       delete(hs,length(hs),1);
  171.                       getopstr := hs;
  172.                     end;
  173.        top_ref : getopstr:=getreferencestring(preference(o)^);
  174.        top_const : getopstr:='#'+tostr(longint(o));
  175.        top_symbol : begin
  176.              { compare with i386 version, where this is a constant. }
  177.              hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  178.                      move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  179. {                     inc(byte(hs[0]));}
  180. {                     hs[1]:='#';}
  181.                      if pcsymbol(o)^.offset>0 then
  182.                        hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  183.                      else if pcsymbol(o)^.offset<0 then
  184.                        hs:=hs+tostr(pcsymbol(o)^.offset);
  185.                      getopstr:=hs;
  186.                    end;
  187.          else internalerror(10001);
  188.        end;
  189.      end;
  190.  
  191.  
  192.    function getopstr_jmp(t : byte;o : pointer) : string;
  193.      var
  194.        hs : string;
  195.      begin
  196.        case t of
  197.          top_reg : getopstr_jmp:=mot_reg2str[tregister(o)];
  198.          top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
  199.          top_const : getopstr_jmp:=tostr(longint(o));
  200.          top_symbol : begin
  201.                      hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  202.                      move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  203.                      if pcsymbol(o)^.offset>0 then
  204.                        hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  205.                      else if pcsymbol(o)^.offset<0 then
  206.                        hs:=hs+tostr(pcsymbol(o)^.offset);
  207.                      getopstr_jmp:=hs;
  208.                    end;
  209.          else internalerror(10001);
  210.        end;
  211.      end;
  212.  
  213. {****************************************************************************
  214.